home *** CD-ROM | disk | FTP | other *** search
/ Aminet 3 / Aminet 3 - July 1994.iso / Aminet / dev / lang / J4thDemo.lha / Programs / wordcount.f < prev   
Encoding:
FORTH Source  |  1992-09-05  |  1.4 KB  |  75 lines
  1. \ Count words and lines and chars in file.
  2. \
  3. \ Author: Phil Burk
  4. \ Copyright Phil Burk 1988
  5. \
  6. \ 00001 10-Aug-92 mdh     Added '>newline'
  7.  
  8. include? dolines ju:dolines
  9.  
  10. ANEW TASK-WC.F
  11.  
  12. variable WC-#WORDS
  13. variable WC-#LINES
  14. variable WC-#CHARS
  15. variable WC-ERROR
  16.  
  17. : WORDS.LEFT?  ( addr len -- addr' len' true | false )
  18.     bl scan ?dup  ( any left? )
  19.     IF  bl skip ?dup
  20.         IF true
  21.         ELSE drop false
  22.         THEN
  23.     ELSE drop false
  24.     THEN
  25. ;
  26.  
  27. : COUNT.WORDS ( addr len -- count )
  28.     bl skip ?dup
  29.     IF  1 >r
  30.         BEGIN words.left?
  31.         WHILE r> 1+ >r
  32.         REPEAT
  33.         r>
  34.     ELSE drop 0
  35.     THEN
  36. ;
  37.  
  38. : $COUNT.LINE ( $line -- )
  39.     1 wc-#lines +!
  40.     count dup 1+ wc-#chars +!
  41.     count.words wc-#words +!
  42. ;
  43.  
  44. : REPORT.COUNT ( -- )
  45.     >newline    \ 00001
  46.     ." #lines = " wc-#lines @ .
  47.     ." , #words = " wc-#words @ .
  48.     ." , #chars = " wc-#chars @ . cr
  49. ;
  50.  
  51. : WC.USAGE
  52.     cr ." WC by Phil Burk, written in JForth" cr
  53.     ." USAGE:  WC filename" cr
  54.     ." Reports line, word and character count." cr
  55.     wc-error on
  56. ;
  57.  
  58. : WC ( <filename> -- )
  59.     wc-#lines off wc-#words off
  60.     wc-#chars off wc-error off
  61.     what's doline
  62.     what's doline.error
  63.     ' $count.line is doline
  64.     ' wc.usage is doline.error
  65.     dolines
  66.     wc-error @ 0=
  67.     IF report.count
  68.     THEN
  69.     ( reset vectors )
  70.     is doline.error
  71.     is doline
  72. ;
  73.  
  74. cr ." Enter:   WC filename      to print file statistics." cr cr
  75.